(* Creme Caramel Compiler (Triple C) - Michele Caceffo - 2008 *)

open Exceptions;;
open Syntaxtree;;
open Intermediate;;
open Declaration;;
open Expressions;;
open Print;;

(** Contains all the functions to generate the tagret code from the intermediate code instructions list 
    All this methods return unit, or the string which has to be printed out
*)

(** The header of the target code *)
let header = "#include <stdio.h>
#include <stdlib.h>

#define STACK_SIZE 1024
#define REG_SIZE 1024
struct array { int i;float f;int p; };
typedef union {int i; float f;struct array a ;} memory_t;

memory_t stack[STACK_SIZE];
memory_t reg[REG_SIZE];

"

(** Initialize a new stack-pointer 
    @param n The stack-pointer's initial value
*)
let newstack_pointer (n: int) = "\tint stackptr;\n stackptr = baseptr;\n\tstackptr += " ^ (string_of_int (n)) ^ ";\n"

(** The signature of the main function, with the first instructions for initialization
    @param n The number of global variables, used to initialize the stack-pointer's value
*)
let main_start (n: int) = "\nint main(int argc, char** argv) {
\tint baseptr;
\tint stackptr;
\tbaseptr = 0;
\tstackptr = " ^ (string_of_int n) ^ ";\n"

(** The end of the main *)
let main_end = "\n}\n"

(** Used to recover the type of data contained into an element (int or float) 
    @param e The element to check
    @raise TYPE_ERROR If the program is unable to retrive the type
*)
let getElementType (e: element) = match e with
          Reg(r,t)  ->  (
                         match t with
                            DInt    ->  ".i"
                          | DFloat  ->  ".f"
                          | _         ->  raise (TYPE_ERROR "Unable to retrieve data type")
                        )
        | Off(o,tp,_) ->  (
                         match tp with
                            DInt    ->  ".i"
                          | DFloat  ->  ".f"
                          | _         ->  raise (TYPE_ERROR "Unable to retrieve data type")
                        )
        | Val(v)    ->  (
                         match v with
                            I(n)    ->  ".i"
                          | F(r)    ->  ".f"
                        )
        | _         ->  raise (TYPE_ERROR "Unable to retrieve data type")

(** If the element is a declared variable, then if the boolean stored into the element is true (which means that
    is an element declared into a function/procedure) we have to calculate the offset from the basepointer, 
    otherwise we calculate it directly into the stack. Positive offsets are for variables, negative for parameters
    @param e The element to recover
    @raise TYPE_ERROR If the program is unable to find the type (e.g. the type is Bool, but into the memory there 
                      are only int and float)
*)
let c_element (e: element): string = match e with
          Reg(r,t)      ->  (
                             match t with
                                DInt    ->  "reg[" ^ (string_of_int r) ^ "]" ^ (getElementType e)
                              | DFloat  ->  "reg[" ^ (string_of_int r) ^ "]" ^ (getElementType e)
                              | _       ->  raise (TYPE_ERROR "Unable to retrieve data type")
                            )
        | Off(o,tp,b)   ->  (
                             match tp with
                                DInt    ->  if b then "stack[baseptr + " ^ (string_of_int o) ^ "]" ^ (getElementType e)
                                            else "stack[" ^ (string_of_int o) ^ "]" ^ (getElementType e) 
                              | DFloat  ->  if b then "stack[baseptr + " ^ (string_of_int o) ^ "]" ^ (getElementType e)
                                            else "stack[" ^ (string_of_int o) ^ "]" ^ (getElementType e) 
                              | _       ->  raise (TYPE_ERROR "Unable to retrieve data type")
                            )
        | Label(l)      ->  "L" ^ (string_of_int l)
        | Val(v)        ->  (
                             match v with
                                I(n)    ->  string_of_int n
                              | F(r)    ->  string_of_float r
                            )
        | Subr(s)       ->  s ^ "(stackptr);\n"
        | Null          ->  ""

(** Used to calculate the offset for a vector, with the same controls used for normal elements
    @param v The offset for the vector
    @param x The offset from the vector to the selected element
    @raise CONFIRM_RULE If this method is called for something that is not a vector (never occurs)
*)
let array_get (v: element) (x: element) = match v with
          Off(o,DInt,b)     ->  if b then "stack[baseptr + " ^ (string_of_int o) ^ " + " ^ (c_element x) ^ "].i"
                                else "stack[" ^ (string_of_int o) ^ " + " ^ (c_element x) ^ "].i"
        | Off(o,DFloat,b)   ->  if b then "stack[baseptr + " ^ (string_of_int o) ^ " + " ^ (c_element x) ^ "].f"
                                else "stack[" ^ (string_of_int o) ^ " + " ^ (c_element x) ^ "].f"
        | _                 ->  (raise (CONFIRM_RULE "The vector instruction is built in a smart way, so this case never occurs :)"))

(** If the c element is null, it means that the subroutine is void, so we have only to call it, otherwise c is the 
    temporary variable where the return value is stored
    @param a The function call
    @param c The (optional) return register
*)
let c_subroutine (a: element) (c: element) : string = match c with
          Null  ->  (c_element a)
        | _     ->  (c_element c) ^ "\t=\t" ^ (c_element a)

let get_off (e:element) = match e with
      Off(o,tp,b) ->(if b then "baseptr + " ^ (string_of_int o)  
                            else  (string_of_int o)     
                      )
     |Reg(r,t)   -> (  match t with
                            DInt    ->  "reg[" ^ (string_of_int r) ^ "].i" 
                          | DFloat  ->  "reg[" ^ (string_of_int r) ^ "].f" 
                          | _       ->  raise (TYPE_ERROR "Unable to retrieve data type")
                     )
     | Val(v)        ->  (
                             match v with
                                I(n)    ->  string_of_int n
                              | F(r)    ->  string_of_float r
                            )

let get_pointer (e:element) = match e with
       Off(o,tp,b) -> (if b then "stack[baseptr + " ^ (string_of_int o) ^ "].a.p" 
                            else "stack[" ^ (string_of_int o) ^ "].a.p"    
                      )
      |Reg(r,t)   -> (  match t with
                            DInt    ->  "stack[reg[" ^ (string_of_int r) ^ "].i].a.p" 
                          | DFloat  ->  "reg[" ^ (string_of_int r) ^ "].f" 
                          | _       ->  raise (TYPE_ERROR "Unable to retrieve data type")
                     )
      | Null -> ""

let get_value (e:element)=match e with
       Off(o,tp,b) -> (if b then "stack[baseptr + " ^ (string_of_int o) ^ "].a.i" 
                            else "stack[" ^ (string_of_int o) ^ "].a.i"    
                      )
      |Reg(r,t)   -> (match t with
                           DInt    ->  "stack[reg[" ^ (string_of_int r) ^ "].i].a.i" 
                         | DFloat  ->  "stack[reg[" ^ (string_of_int r) ^ "].f].a.f" 
                         | _       ->  raise (TYPE_ERROR "Unable to retrieve data type")
                      )
      | Null -> ""

(** Conver the intermediate code instructions into the target code instructions 
    @param i The instruction to convert
    @param out The output channel
    @param proct The subroutines table
    @raise CONFIRM_RULE If the OUT instruction is called with something that is not a variable (never occurs)
*)
let c_instruction (i: instruction) (out: out_channel) (proct: proc_table)  = match i with
          (GAP,a,b,c)      ->  output_string out ((c_element a) ^ "\t=\t" ^ (get_pointer b) ^ ";\n")
        | (GAV,a,b,c)      ->  output_string out ((c_element a) ^ "\t=\t" ^ (get_value b) ^ ";\n")
        | (SAP,a,b,c)      ->  output_string out ((get_pointer a) ^ "\t=\t" ^ (get_off b) ^ ";\n")
        | (SAV,a,b,c)      ->  output_string out ((get_value a) ^ "\t=\t" ^ (c_element b) ^ ";\n")
        | (CPY,a,b,c)       ->  output_string out ((c_element c) ^ "\t=\t" ^ (c_element a) ^ ";\n")
        | (AGET,a,b,c)      ->  output_string out ((c_element c) ^ "\t=\t" ^ (array_get a b) ^ ";\n")
        | (ASET,a,b,c)      ->  output_string out ((array_get a b) ^ "\t=\t" ^ (c_element c) ^ ";\n")
        | (ADD,a,b,c)       ->  output_string out ((c_element c) ^ "\t=\t" ^ (c_element a) ^ "+" ^ (c_element b) ^ ";\n")
        | (SUB,a,b,c)       ->  output_string out ((c_element c) ^ "\t=\t" ^ (c_element a) ^ "-" ^ (c_element b) ^ ";\n")
        | (MUL,a,b,c)       ->  output_string out ((c_element c) ^ "\t=\t" ^ (c_element a) ^ "*" ^ (c_element b) ^ ";\n")
        | (DIV,a,b,c)       ->  output_string out ((c_element c) ^ "\t=\t" ^ (c_element a) ^ "/" ^ (c_element b) ^ ";\n")
        | (AND,a,b,c)       ->  output_string out ((c_element c) ^ "\t=\t" ^ (c_element a) ^ "&&" ^ (c_element b) ^ ";\n")
        | (OR,a,b,c)        ->  output_string out ((c_element c) ^ "\t=\t" ^ (c_element a) ^ "||" ^ (c_element b) ^ ";\n")
        | (NOT,a,b,c)       ->  output_string out ((c_element c) ^ "= !" ^ (c_element a) ^ ";\n")
        | (CEQU,a,b,c)      ->  output_string out ((c_element c) ^ "\t=\t" ^ (c_element a) ^ "==" ^ (c_element b) ^ ";\n")
        | (CNE,a,b,c)       ->  output_string out ((c_element c) ^ "\t=\t" ^ (c_element a) ^ "!=" ^ (c_element b) ^ ";\n")
        | (CG,a,b,c)        ->  output_string out ((c_element c) ^ "\t=\t" ^ (c_element a) ^ ">" ^ (c_element b) ^ ";\n")
        | (CGE,a,b,c)       ->  output_string out ((c_element c) ^ "\t=\t" ^ (c_element a) ^ ">=" ^ (c_element b) ^ ";\n")
        | (CLE,a,b,c)       ->  output_string out ((c_element c) ^ "\t=\t" ^ (c_element a) ^ "<=" ^ (c_element b) ^ ";\n")
        | (JNE,a,b,c)       ->  output_string out ("if (" ^ (c_element a) ^ "!=" ^ (c_element b) ^ ") goto " ^ (c_element c) ^ ";\n")
        | (JIE,a,b,c)       ->  output_string out ("if (" ^ (c_element a) ^ "==" ^ (c_element b) ^ ") goto " ^ (c_element c) ^ ";\n")
        | (GOTO,a,b,c)      ->  output_string out ("goto " ^ (c_element a) ^ ";\n")
        | (HALT,a,b,c)      ->  output_string out ("exit(0);\n")
        | (OUT,a,b,c)       ->  (
                                 match a with
                                    Reg(r,t)    ->  (
                                                     match t with
                                                          DInt    ->  output_string out ("printf(\"%d\\n\", reg[" ^ (string_of_int r) ^ "].i);\n")
                                                        | DFloat  ->  output_string out ("printf(\"%f\\n\", reg[" ^ (string_of_int r) ^ "].f);\n")
                                                        | _       ->  raise (TYPE_ERROR "Unable to retrieve data type")
                                                    )
                                  | Off(o,tp,b)   -> (match tp with
                                                         DInt   -> (
                                                                    if b then (
                                                                        (output_string out (
                                                                            "printf(\"%d\\n\", stack[baseptr + " ^ (string_of_int o) ^ "]" ^ (getElementType a) ^ 
                                                                            ");\n"
                                                                        ))
                                                                    ) else (
                                                                        (output_string out (
                                                                            "printf(\"%d\\n\", stack[" ^ (string_of_int o) ^ "]" ^ (getElementType a) ^ ");\n"
                                                                         ))
                                                                    )
                                                                   )
                                                       | DFloat -> (
                                                                    if b then (
                                                                        (output_string out (
                                                                            "printf(\"%f\\n\", stack[baseptr + " ^ (string_of_int o) ^ "]" ^ (getElementType a) ^ 
                                                                            ");\n"
                                                                            ))
                                                                    ) else (
                                                                        (output_string out (
                                                                            "printf(\"%f\\n\", stack[" ^ (string_of_int o) ^ "]" ^ (getElementType a) ^ ");\n"
                                                                        ))
                                                                    )
                                                                   )
                                                     | _         ->  raise (TYPE_ERROR "Unable to retrieve data type")
                                                    )
                                  | Val(I(v))   ->  output_string out ("printf(\"%d\\n\", " ^ (c_element a) ^ ");\n")
                                  | Val(F(v))   ->  output_string out ("printf(\"%f\\n\", " ^ (c_element a) ^ ");\n")
                                  | _           ->  (raise (CONFIRM_RULE "This case should never occur"))
                                )
        | (NOP,a,b,c)       ->  output_string out ("\n")
        | (PARAM,a,b,c)     ->  output_string out ("stack[stackptr++]" ^ (getElementType a) ^ "\t=\t" ^ (c_element a) ^ ";\n")
        | (CALL,a,b,c)      ->  output_string out (c_subroutine a c)
        | (RET,a,b,c)       ->  output_string out ("return " ^ (c_element a) ^ ";\n")

(** Generates the target code for all the elements of the instructions list
    @param il The list of instructions
    @param ic The intermediateCode class instance
    @param out The output channel
    @param n The index of the next instruction, used to check the label table
    @param proct The subroutines table
*)
let rec c_generator (il: instruction list) (ic: intermediateCode) (out: out_channel) (n: int) (proct: proc_table) = match il with
          []    ->  ()
        | i::is ->  (
                     if(ic#hasLabel n) then (
                        let l = (ic#getInstrLabel n) in 
                        output_string out ((c_element l) ^ ":\n");
                     );
                     c_instruction i out proct;
                     c_generator is ic out (n+1) proct
                    )

(** Prints the return type of the subroutines
    @param r The return type
*)
let print_return (r: return): string = match r with
          SRet(Int)     ->  "int "
        | SRet(Float)   ->  "float "
        | Void          ->  "void "

(** Generates the target code for the subroutine prototype declaration, using the stored funUtils instance 
    @param out The output channel
    @param ic The intermediateCode class instance 
    @param proct The subroutines table
    @param Ide(id) The subroutine name
    @param p The entry binded with the subroutine name
    @raise CONFIRM_RULE When the proc_entry is Building (never occurs)
*)
let c_procedure_prototype (out: out_channel) (ic: intermediateCode) (proct: proc_table) (Ide(id): ide) (p: proc_entry) = match p with 
          Subroutine(r,dlist,dect,funcPar)  ->  (
                                                 output_string out ((print_return r) ^ (id) ^ "(int baseptr);\n\r";)
                                                )
        | Building(r,dlist)                 ->  raise (CONFIRM_RULE "Why should I have some subroutines in building phase here?")


(** Generates the target code for the subroutines, using the stored funUtils instance 
    @param out The output channel
    @param ic The intermediateCode class instance 
    @param proct The subroutines table
    @param Ide(id) The subroutine name
    @param p The entry binded with the subroutine name
    @raise CONFIRM_RULE When the proc_entry is Building (never occurs)
*)
let c_procedure (out: out_channel) (ic: intermediateCode) (proct: proc_table) (Ide(id): ide) (p: proc_entry) = match p with 
          Subroutine(r,dlist,dect,funcPar)  ->  (
                                                 let oldinstr = ic#getInstructionClass in (
                                                     ic#setInstructionClass funcPar;
                                                     print_DecTable (out) (dect);
                                                     output_string out (
                                                         (print_return r) ^ (id) ^ "(int baseptr) {\n" ^ 
                                                         (newstack_pointer ((Hashtbl.length dect) - List.length dlist))
                                                     );
                                                     c_generator (funcPar#getInl) (ic) (out) (0) proct;
                                                     output_string out "}\n\r";
                                                     ic#setInstructionClass oldinstr;
                                                 )
                                                )
        | Building(r,dlist)                 ->  raise (CONFIRM_RULE "Why should I have some subroutines in building phase here?")

(** Calls the c_procedure method for all the entries of the procedure table
    @param out The output channel
    @param proct The subroutines table
    @param ic The intermediateCode class instance
*)
let c_subroutines (out: out_channel) (proct: proc_table) (ic: intermediateCode) = (
		output_string out "\n\r";
		Hashtbl.iter (c_procedure_prototype out ic proct) proct;
        Hashtbl.iter (c_procedure out ic proct) proct;
)
